(*
  Copyright (c) 2009 Barry Schwartz

  Permission is hereby granted, free of charge, to any person
  obtaining a copy of this software and associated documentation
  files (the "Software"), to deal in the Software without
  restriction, including without limitation the rights to use,
  copy, modify, merge, publish, distribute, sublicense, and/or sell
  copies of the Software, and to permit persons to whom the
  Software is furnished to do so, subject to the following
  conditions:

  The above copyright notice and this permission notice shall be
  included in all copies or substantial portions of the Software.

  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
  OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
  NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
  HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
  WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
  FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
  OTHER DEALINGS IN THE SOFTWARE.
*)

open XNum
open UTypes
open Logging
open Dim
open Box
  
type page =
  { p_width : num;                      (* dimensions *)
    p_height : num;
    p_used : unit PlanePartition.map;   (* area covered by boxes *)
    p_boxes : (num * num * box) list
  }

(* list of boxes and their position *)
type area_shape =
  (* an area of the page                          *)
  { as_pos_x : num; (* position of the base line                    *)
    as_pos_y : num; as_width : num; as_height : num;
    (* distance between first and last baseline     *) as_top : num;
    (* maximal amount the area might extend above   *) as_bottom : num
  }

(* the first and below the last baseline        *)
let new_page width height =
  {
    p_width = width;
    p_height = height;
    p_used = PlanePartition.empty num_zero num_zero width height;
    p_boxes = [];
  }
  
(* |allocate_rect <page> <x> <y> <width> <height>| marks the given rectangle as used. *)
let allocate_rect page x y width height =
  {
    (page)
    with
    p_used =
      PlanePartition.set_rect page.p_used x y (add_num x width)
        (sub_num y height) ();
  }
  
(* |put_box <page> <x> <y> <box>| adds <box> to <page>. *)
let put_box page x y box =
  { (page) with p_boxes = (x, y, box) :: page.p_boxes; }
  
(*
  |pub_box_on_page <page> <x> <y> <box>| is a convenient wrapper for |allocate_rect| and |put_box|
  that adds <box> to <page> at position (<x>, <y>) and marks the covered area as used.
*)
let put_box_on_page page x y box =
  {
    (page)
    with
    p_boxes = (x, y, box) :: page.p_boxes;
    p_used =
      PlanePartition.set_rect page.p_used x (sub_num y box.b_depth.d_base)
        (add_num x box.b_width.d_base) (add_num y box.b_height.d_base) ();
  }
  
let find_place_in_area_top page area top height bottom =
  let total_height =
    xdim_to_dim (xdim_add_dim (xdim_add_dim height top) bottom) in
  let min_height = dim_min_value total_height in
  let min_top =
    if total_height.d_shrink_order = 0
    then (dim_scale_upto top (num_minus_one, 0)).d_base
    else
      (dim_scale_upto top ((top.d_base), (total_height.d_shrink_order))).
        d_base in
  let min_bottom =
    if total_height.d_shrink_order = 0
    then (dim_scale_upto bottom (num_minus_one, 0)).d_base
    else
      (dim_scale_upto bottom ((bottom.d_base), (total_height.d_shrink_order))).
        d_base in
  let min_top_shift = max_num num_zero (sub_num min_top area.as_top) in
  let min_bottom_shift = max_num num_zero (sub_num min_bottom area.as_bottom)
  in
    match PlanePartition.find_free_top page.p_used area.as_pos_x
            (add_num (sub_num area.as_pos_y area.as_height) min_bottom_shift)
            (add_num area.as_pos_x area.as_width)
            (sub_num area.as_pos_y min_top_shift) min_height
    with
    | None -> None
    | Some ((a1, a2)) ->
        let b2 = min_num a2 (add_num area.as_pos_y area.as_top) in
        (* First try the maximal height. *)
        let h =
          if le_num (add_num a1 total_height.d_base) a2
          then total_height.d_base
          else sub_num a2 a1 in
        let r = adjustment_ratio total_height h in
        let t = (dim_scale_upto top r).d_base in
        let b = (dim_scale_upto bottom r).d_base in
        (* Are the top and bottom baselines ok? *)
        let top_baseline = sub_num b2 t in
        let bottom_baseline = add_num (sub_num b2 h) b
        in
          if
            (le_num top_baseline area.as_pos_y) &&
              ((ge_num bottom_baseline (sub_num area.as_pos_y area.as_height))
                 && (ge_num bottom_baseline (add_num a1 b)))
          then Some ((top_baseline, r))
          else (* Shrink box to fit. *)
            (let top_shift =
               max_num num_zero (sub_num top_baseline area.as_pos_y) in
             let bot_shift =
               max_num num_zero
                 (sub_num
                    (max_num (sub_num area.as_pos_y area.as_height)
                       (add_num a1 b))
                    bottom_baseline) in
             let r =
               adjustment_ratio total_height
                 (sub_num (sub_num h top_shift) bot_shift)
             in Some (((sub_num top_baseline top_shift), r)))
  
let find_place_in_area_bottom page area top height bottom =
  let total_height =
    xdim_to_dim (xdim_add_dim (xdim_add_dim height top) bottom) in
  let min_height = dim_min_value total_height in
  let min_top =
    if total_height.d_shrink_order = 0
    then (dim_scale_upto top (num_minus_one, 0)).d_base
    else
      (dim_scale_upto top ((top.d_base), (total_height.d_shrink_order))).
        d_base in
  let min_bottom =
    if total_height.d_shrink_order = 0
    then (dim_scale_upto bottom (num_minus_one, 0)).d_base
    else
      (dim_scale_upto bottom ((bottom.d_base), (total_height.d_shrink_order))).
        d_base in
  let min_top_shift = max_num num_zero (sub_num min_top area.as_top) in
  let min_bottom_shift = max_num num_zero (sub_num min_bottom area.as_bottom)
  in
    match PlanePartition.find_free_bottom page.p_used area.as_pos_x
            (add_num (sub_num area.as_pos_y area.as_height) min_bottom_shift)
            (add_num area.as_pos_x area.as_width)
            (sub_num area.as_pos_y min_top_shift) min_height
    with
    | None -> None
    | Some ((a1, a2)) ->
        let b1 =
          max_num a1
            (sub_num (sub_num area.as_pos_y area.as_height) area.as_bottom) in
        (* First try the maximal height. *)
        let h =
          if le_num (add_num a1 total_height.d_base) a2
          then total_height.d_base
          else sub_num a2 a1 in
        let r = adjustment_ratio total_height h in
        let t = (dim_scale_upto top r).d_base in
        let b = (dim_scale_upto bottom r).d_base in
        (* Are the top and bottom baselines ok? *)
        let top_baseline = sub_num (add_num b1 h) t in
        let bottom_baseline = add_num b1 b
        in
          if
            (le_num top_baseline area.as_pos_y) &&
              ((le_num top_baseline (sub_num a2 t)) &&
                 (ge_num bottom_baseline
                    (sub_num area.as_pos_y area.as_height)))
          then Some ((top_baseline, r))
          else (* Shrink box to fit. *)
            (let top_shift =
               max_num num_zero
                 (sub_num top_baseline (max_num area.as_pos_y (sub_num a2 t))) in
             let bot_shift =
               max_num num_zero
                 (sub_num (sub_num area.as_pos_y area.as_height)
                    bottom_baseline) in
             let r =
               adjustment_ratio total_height
                 (sub_num (sub_num h top_shift) bot_shift)
             in Some (((sub_num top_baseline top_shift), r)))
  
let find_place_in_area_horiz find page area width =
  let min_width = dim_min_value width
  in
    match find page.p_used area.as_pos_x area.as_pos_y
            (add_num area.as_pos_x area.as_width)
            (sub_num area.as_pos_y area.as_height) min_width
    with
    | None -> None
    | Some ((a, b)) ->
        if le_num (add_num a width.d_base) b
        then Some ((a, (num_zero, 0)))
        else Some ((a, (adjustment_ratio width (sub_num b a))))
  
let find_place_in_area_left page area width =
  find_place_in_area_horiz PlanePartition.find_free_left page area width
  
let find_place_in_area_right page area width =
  find_place_in_area_horiz PlanePartition.find_free_right page area width
  
let area_free_vert page area =
  let rec (* calculate reversed complement of interval list *)
    iter y strip result =
    match strip with
    | [] -> (y, (page.p_height)) :: result
    | (a, b) :: cs -> iter b cs ((y, a) :: result)
  in
    iter num_zero
      (PlanePartition.vert_strip page.p_used area.as_pos_x
         (add_num area.as_pos_x area.as_width))
      []
  
let area_free_horiz page area =
  let rec (* calculate complement of interval list *) iter x strip =
    match strip with
    | [] -> [ (x, (page.p_width)) ]
    | (a, b) :: cs -> (x, a) :: (iter b cs)
  in
    iter num_zero
      (PlanePartition.horiz_strip page.p_used
         (add_num area.as_pos_y area.as_top)
         (sub_num (sub_num area.as_pos_y area.as_height) area.as_bottom))
  

